home *** CD-ROM | disk | FTP | other *** search
/ PC Plus SuperCD (UK) 1999 January / PC Plus Super CD No55a (PCP-147A-1-99) (Disc 1) (1998).iso / linux / developers / visualtcl / windows / vtcl / lib / dragsize.tcl < prev    next >
Encoding:
Text File  |  1997-05-27  |  7.4 KB  |  222 lines
  1. ##############################################################################
  2. # $Id: dragsize.tcl,v 1.4 1997/05/28 02:34:03 stewart Exp $
  3. #
  4. # dragsize.tcl - procedures to handle widget sizing and movement
  5. #
  6. # Copyright (C) 1996-1997 Stewart Allen
  7. #
  8. # This program is free software; you can redistribute it and/or
  9. # modify it under the terms of the GNU General Public License
  10. # as published by the Free Software Foundation; either version 2
  11. # of the License, or (at your option) any later version.
  12. #
  13. # This program is distributed in the hope that it will be useful,
  14. # but WITHOUT ANY WARRANTY; without even the implied warranty of
  15. # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16. # GNU General Public License for more details.
  17. #
  18. # You should have received a copy of the GNU General Public License
  19. # along with this program; if not, write to the Free Software
  20. # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  21.  
  22. ##############################################################################
  23. #
  24.  
  25. proc vTcl:bind_button_1 {target x y} {
  26.     global vTcl
  27.     if {[lindex [split %W .] 1] != "vTcl"} {
  28.         if {$target != "." && [winfo class $target] != "Toplevel"} {
  29.             vTcl:active_widget $target
  30.             vTcl:grab $target $x $y
  31.             set vTcl(cursor,last) [$target cget -cursor]
  32.             $target configure -cursor fleur
  33.         } else {
  34.             vTcl:active_widget $target
  35.         }
  36.     }
  37. }
  38.  
  39. proc vTcl:bind_button_2 {target x y} {
  40.     global vTcl
  41.     if {$vTcl(w,widget) != "." && \
  42.         [winfo class $vTcl(w,widget)] != "Toplevel" && \
  43.         $vTcl(w,widget) != ""} {
  44.             vTcl:grab $vTcl(w,widget) $x $y
  45.             set vTcl(cursor,last) [$vTcl(w,widget) cget -cursor]
  46.             $vTcl(w,widget) configure -cursor fleur
  47.     }
  48. }
  49.  
  50. proc vTcl:bind_motion {x y} {
  51.     global vTcl
  52.     if {$vTcl(w,widget) != "." && $vTcl(w,class) != "Toplevel"} {
  53.         vTcl:grab_motion $vTcl(w,widget) $x $y
  54.     }
  55. }
  56.  
  57. proc vTcl:bind_release {x y} {
  58.     global vTcl
  59.     if {$vTcl(w,widget) == ""} {return}
  60.     $vTcl(w,widget) configure -cursor "$vTcl(cursor,last)"
  61.     vTcl:place_handles $vTcl(w,widget)
  62.     vTcl:grab_release $vTcl(w,widget)
  63.     vTcl:update_widget_info $vTcl(w,widget)
  64. }
  65.  
  66. proc vTcl:grab {widget absX absY} {
  67.     global vTcl
  68.     grab $widget
  69.     set vTcl(w,didmove) 0
  70.     set vTcl(grab,startX) [vTcl:grid_snap x $absX]
  71.     set vTcl(grab,startY) [vTcl:grid_snap y $absY]
  72. }
  73.  
  74. proc vTcl:grab_motion {widget absX absY} {
  75.     global vTcl
  76.     set vTcl(w,didmove) 1
  77.     if { $vTcl(w,manager) == "place" } {
  78.         place $widget \
  79.             -x [vTcl:grid_snap x \
  80.                 [expr $absX-$vTcl(grab,startX)+$vTcl(w,x)]] \
  81.             -y [vTcl:grid_snap y \
  82.                 [expr $absY-$vTcl(grab,startY)+$vTcl(w,y)]]
  83.     }
  84.     vTcl:place_handles $widget
  85. }
  86.  
  87. proc vTcl:grab_release {widget} {
  88.     global vTcl
  89.     grab release $widget
  90.     if { $vTcl(w,didmove) == 1 } {
  91.         set vTcl(undo) [vTcl:dump_widget_quick $vTcl(w,widget)]
  92.         vTcl:passive_push_action $vTcl(undo) $vTcl(redo)
  93.     }
  94. }
  95.  
  96. proc vTcl:grab_resize {absX absY handle} {
  97.     global vTcl
  98.     set vTcl(w,didmove) 1
  99.     set widget $vTcl(w,widget)
  100.     set X [vTcl:grid_snap x $absX]
  101.     set Y [vTcl:grid_snap y $absY]
  102.     set deltaX [expr $X - $vTcl(grab,startX)]
  103.     set deltaY [expr $Y - $vTcl(grab,startY)]
  104.     switch $vTcl(w,manager) {
  105.         place {
  106.             switch $handle {
  107.                 n {
  108.                     set newX $vTcl(w,x)
  109.                     set newY [expr $vTcl(w,y) + $deltaY]
  110.                     set newW $vTcl(w,width)
  111.                     set newH [expr $vTcl(w,height) - $deltaY]
  112.                 }
  113.                 e {
  114.                     set newX $vTcl(w,x)
  115.                     set newY $vTcl(w,y)
  116.                     set newW [expr $vTcl(w,width) + $deltaX]
  117.                     set newH $vTcl(w,height)
  118.                 }
  119.                 s {
  120.                     set newX $vTcl(w,x)
  121.                     set newY $vTcl(w,y)
  122.                     set newW $vTcl(w,width)
  123.                     set newH [expr $vTcl(w,height) + $deltaY]
  124.                 }
  125.                 w {
  126.                     set newX [expr $vTcl(w,x) + $deltaX]
  127.                     set newY $vTcl(w,y)
  128.                     set newW [expr $vTcl(w,width) - $deltaX]
  129.                     set newH $vTcl(w,height)
  130.                 }
  131.                 nw {
  132.                     set newX [expr $vTcl(w,x) + $deltaX]
  133.                     set newY [expr $vTcl(w,y) + $deltaY]
  134.                     set newW [expr $vTcl(w,width) - $deltaX]
  135.                     set newH [expr $vTcl(w,height) - $deltaY]
  136.                 }
  137.                 ne {
  138.                     set newX $vTcl(w,x)
  139.                     set newY [expr $vTcl(w,y) + $deltaY]
  140.                     set newW [expr $vTcl(w,width) + $deltaX]
  141.                     set newH [expr $vTcl(w,height) - $deltaY]
  142.                 }
  143.                 se {
  144.                     set newX $vTcl(w,x)
  145.                     set newY $vTcl(w,y)
  146.                     set newW [expr $vTcl(w,width) + $deltaX]
  147.                     set newH [expr $vTcl(w,height) + $deltaY]
  148.                 }
  149.                 sw {
  150.                     set newX [expr $vTcl(w,x) + $deltaX]
  151.                     set newY $vTcl(w,y)
  152.                     set newW [expr $vTcl(w,width) - $deltaX]
  153.                     set newH [expr $vTcl(w,height) + $deltaY]
  154.                 }
  155.             }
  156.             place $widget -x $newX -y $newY -width $newW -height $newH
  157.         }
  158.         grid -
  159.         pack {
  160.             switch $vTcl(w,class) {
  161.                 Label -
  162.                 Entry -
  163.                 Message -
  164.                 Scrollbar -
  165.                 Scale {
  166.                     set vTcl(w,opt,-height) ""
  167.                 }
  168.             }
  169.             switch $handle {
  170.                 n {
  171.                     set newW $vTcl(w,opt,-width)
  172.                     set newH [expr $vTcl(w,opt,-height) - $deltaY]
  173.                 }
  174.                 e {
  175.                     set newW [expr $vTcl(w,opt,-width) + $deltaX]
  176.                     set newH $vTcl(w,opt,-height)
  177.                 }
  178.                 s {
  179.                     set newW $vTcl(w,opt,-width)
  180.                     set newH [expr $vTcl(w,opt,-height) + $deltaY]
  181.                 }
  182.                 w {
  183.                     set newW [expr $vTcl(w,opt,-width) - $deltaX]
  184.                     set newH $vTcl(w,opt,-height)
  185.                 }
  186.                 nw {
  187.                     set newW [expr $vTcl(w,opt,-width) - $deltaX]
  188.                     set newH [expr $vTcl(w,opt,-height) - $deltaY]
  189.                 }
  190.                 ne {
  191.                     set newW [expr $vTcl(w,opt,-width) + $deltaX]
  192.                     set newH [expr $vTcl(w,opt,-height) - $deltaY]
  193.                 }
  194.                 se {
  195.                     set newW [expr $vTcl(w,opt,-width) + $deltaX]
  196.                     set newH [expr $vTcl(w,opt,-height) + $deltaY]
  197.                 }
  198.                 sw {
  199.                     set newW [expr $vTcl(w,opt,-width) - $deltaX]
  200.                     set newH [expr $vTcl(w,opt,-height) + $deltaY]
  201.                 }
  202.             }
  203.             if { $newW < 0 } { set newW 0 }
  204.             if { $newH < 0 } { set newH 0 }
  205.             switch $vTcl(w,class) {
  206.                 Label -
  207.                 Entry -
  208.                 Message -
  209.                 Scrollbar -
  210.                 Scale {
  211.                     $widget configure -width $newW
  212.                 }
  213.                 default {
  214.                     $widget configure -width $newW -height $newH
  215.                 }
  216.             }
  217.         }
  218.     }
  219.     vTcl:place_handles $widget
  220. }
  221.  
  222.